Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-02/icndrw_1.zip/SOURCE.ZIP/MOUSE.PAS

Pascal/Delphi Source File | 1991-08-20 | 8KB | 444 lines

{-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-

                      ===============================
                      Microsoft Compatible Mouse Unit
                           For Turbo Pascal 6.0
                      ===============================

                      Copyright (c) 1991 - SofDesign Technology
                      All Rights Reserved

 -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}

unit mouse;

{$O-}
{$R-}
{$S-}
{$A+}
{$B-}
{$F-}

interface

uses dos;

type
 mouseshape=record
             hotx,hoty:word;
             shape,mask:array[1..16] of word;
            end;

function  driverinstalled:boolean;
function  resetmouse:integer;
procedure showmouse;
procedure hidemouse;
procedure getmouse (var x,y,b:word);
procedure setmouse (x,y:word);
procedure getbuttonpress (whichbutton:word;
                          var status,presses,xpress,ypress:word);
procedure getbuttonrelease (whichbutton:word;
                            var status,presses,xrelease,yrelease:word);
procedure hmouselimit (min,max:word);
procedure vmouselimit (min,max:word);
procedure setmouseshape (var form:mouseshape);
procedure settextcursor (cursorselect,screenmask,cursormask:word);
procedure readcounters (var hmickey,vmickey:word);
procedure setinterrupt (routine:pointer; mask:word);
procedure emulatepen;
procedure stopemulatepen;
procedure setmickeyratio (xmickey,ymickey:word);
procedure conditionaloff (x1,y1,x2,y2:word);
procedure setthreshold (mickeys:word);
procedure swapinterruptroutines (var routine:pointer; var mask:word);
function  statebuffersize:word;
procedure savestate (var buffer);
procedure restorestate (var buffer);
function  setaltinterrupt (routine:pointer; mask:word):boolean;
function  getaltinterrupt (oldmask:word; var routinemask:word;
                          var routine:pointer):boolean;
procedure setsensitivity (xmickey,ymickey,threshold:word);
procedure getsensitivity (var xmickey,ymickey,threshold:word);
procedure setinterruptrate (rate:word);
procedure setcrtpage (page:word);
function  getcrtpage:word;
function  disabledriver (var oldint33:pointer):boolean;
procedure enabledriver;
function  softwarereset:boolean;
procedure setlanguage(language:word);
function  getlanguage:word;
procedure getvertypeirq (var version,mousetype,irqnumber:word);


implementation

function driverinstalled:boolean;
var
 r:registers;
begin
 r.ax:=$3533;
 msdos(r);
 driverinstalled:=not((r.es=0) and (r.bx=0) or (mem[r.es:r.bx]=207));
end;

function resetmouse:integer;
var
 r:registers;
begin
 r.ax:=0;
 intr($33,r);
 if integer(r.ax)=-1 then resetmouse:=integer(r.bx) else resetmouse:=0;
end;

procedure showmouse;
var
 r:registers;
begin
 r.ax:=1;
 intr($33,r);
end;

procedure hidemouse;
var
 r:registers;
begin
 r.ax:=2;
 intr($33,r);
end;

procedure getmouse (var x,y,b:word);
var
 r:registers;
begin
 r.ax:=3;
 intr($33,r);
 x:=r.cx;
 y:=r.dx;
 b:=r.bx;
end;

procedure setmouse (x,y:word);
var
 r:registers;
begin
 r.ax:=4;
 r.cx:=x;
 r.dx:=y;
 intr($33,r);
end;

procedure getbuttonpress (whichbutton:word;
                          var status,presses,xpress,ypress:word);
var
 r:registers;
begin
 r.ax:=5;
 r.bx:=whichbutton;
 intr($33,r);
 status:=r.ax;
 presses:=r.bx;
 xpress:=r.cx;
 ypress:=r.dx;
end;

procedure getbuttonrelease (whichbutton:word;
                            var status,presses,xrelease,yrelease:word);
var
 r:registers;
begin
 r.ax:=6;
 r.bx:=whichbutton;
 intr($33,r);
 status:=r.ax;
 presses:=r.bx;
 xrelease:=r.cx;
 yrelease:=r.dx;
end;

procedure hmouselimit (min,max:word);
var
 r:registers;
begin
 r.ax:=7;
 r.cx:=min;
 r.dx:=max;
 intr($33,r);
end;

procedure vmouselimit (min,max:word);
var
 r:registers;
begin
 r.ax:=8;
 r.cx:=min;
 r.dx:=max;
 intr($33,r);
end;

procedure setmouseshape (var form:mouseshape);
var
 r:registers;
begin
 r.ax:=9;
 r.bx:=form.hotx;
 r.cx:=form.hoty;
 r.ds:=seg(form.shape);
 r.es:=r.ds;
 r.dx:=ofs(form.shape);
 intr($33,r);
end;

procedure settextcursor (cursorselect,screenmask,cursormask:word);
var
 r:registers;
begin
 r.ax:=10;
 r.bx:=cursorselect;
 r.cx:=screenmask;
 r.dx:=cursormask;
 intr($33,r);
end;

procedure readcounters (var hmickey,vmickey:word);
var
 r:registers;
begin
 r.ax:=11;
 intr($33,r);
 hmickey:=r.cx;
 vmickey:=r.dx;
end;

procedure setinterrupt (routine:pointer; mask:word);
var
 r:registers;
begin
 r.ax:=12;
 r.cx:=mask;
 r.dx:=ofs(routine^);
 r.es:=seg(routine^);
 intr($33,r);
end;

procedure emulatepen;
var
 r:registers;
begin
 r.ax:=13;
 intr($33,r);
end;

procedure stopemulatepen;
var
 r:registers;
begin
 r.ax:=14;
 intr($33,r);
end;

procedure setmickeyratio (xmickey,ymickey:word);
var
 r:registers;
begin
 r.ax:=15;
 r.cx:=xmickey;
 r.dx:=ymickey;
 intr($33,r);
end;

procedure conditionaloff (x1,y1,x2,y2:word);
var
 r:registers;
begin
 r.ax:=16;
 r.cx:=x1;
 r.dx:=y1;
 r.si:=x2;
 r.di:=y2;
 intr($33,r);
end;

procedure setthreshold (mickeys:word);
var
 r:registers;
begin
 r.ax:=19;
 r.dx:=mickeys;
 intr($33,r);
end;

procedure swapinterruptroutines (var routine:pointer; var mask:word);
var
 r:registers;
begin
 r.ax:=20;
 r.bx:=seg(routine^);
 r.cx:=mask;
 r.dx:=ofs(routine^);
 intr($33,r);
end;

function statebuffersize:word;
var
 r:registers;
begin
 r.ax:=21;
 intr($33,r);
 statebuffersize:=r.bx;
end;

procedure savestate (var buffer);
var
 r:registers;
begin
 r.ax:=22;
 r.es:=seg(buffer);
 r.ds:=r.es;
 r.dx:=ofs(buffer);
 intr($33,r);
end;

procedure restorestate (var buffer);
var
 r:registers;
begin
 r.ax:=23;
 r.es:=seg(buffer);
 r.ds:=r.es;
 r.dx:=ofs(buffer);
 intr($33,r);
end;

function setaltinterrupt (routine:pointer; mask:word):boolean;
var
 r:registers;
begin
 r.ax:=24;
 r.cx:=mask;
 r.dx:=ofs(routine^);
 r.es:=seg(routine^);
 intr($33,r);
 setaltinterrupt:=integer(r.ax)<>-1;
end;

function getaltinterrupt (oldmask:word; var routinemask:word;
                          var routine:pointer):boolean;
var
 r:registers;
begin
 r.ax:=25;
 r.cx:=oldmask;
 intr($33,r);
 getaltinterrupt:=integer(r.ax)<>-1;
 routine:=ptr(r.bx,r.dx);
 routinemask:=r.cx;
end;

procedure setsensitivity (xmickey,ymickey,threshold:word);
var
 r:registers;
begin
 r.ax:=26;
 r.bx:=xmickey;
 r.cx:=ymickey;
 r.dx:=threshold;
 intr($33,r);
end;

procedure getsensitivity (var xmickey,ymickey,threshold:word);
var
 r:registers;
begin
 r.ax:=27;
 intr($33,r);
 xmickey:=r.bx;
 ymickey:=r.cx;
 threshold:=r.dx;
end;

procedure setinterruptrate (rate:word);
var
 r:registers;
begin
 r.ax:=28;
 if rate>4 then r.bx:=4 else r.bx:=rate;
 intr($33,r);
end;

procedure setcrtpage (page:word);
var
 r:registers;
begin
 r.ax:=29;
 r.bx:=page;
 intr($33,r);
end;

function getcrtpage:word;
var
 r:registers;
begin
 r.ax:=30;
 intr($33,r);
 getcrtpage:=r.bx;
end;

function disabledriver (var oldint33:pointer):boolean;
var
 r:registers;
begin
 r.ax:=31;
 intr($33,r);
 oldint33:=ptr(r.cx,r.bx);
 disabledriver:=integer(r.ax)<>-1;
end;

procedure enabledriver;
var
 r:registers;
begin
 r.ax:=32;
 intr($33,r);
end;

function softwarereset:boolean;
var
 r:registers;
begin
 r.ax:=33;
 intr($33,r);
 softwarereset:=(integer(r.ax)=-1) and (r.bx=2);
end;

procedure setlanguage(language:word);
var
 r:registers;
begin
 r.ax:=34;
 r.bx:=language;
 intr($33,r);
end;

function getlanguage:word;
var
 r:registers;
begin
 r.ax:=35;
 intr($33,r);
 getlanguage:=r.bx;
end;

procedure getvertypeirq (var version,mousetype,irqnumber:word);
var
 r:registers;
begin
 r.ax:=36;
 intr($33,r);
 version:=r.bx;
 mousetype:=r.ch;
 irqnumber:=r.cl;
end;

end.